/*
 * Copyright (C) 2008,2009,2010,2011  Paulo Cesar Pereira de Andrade.
 *
 * This is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * Authors:
 *	Paulo Cesar Pereira de Andrade
 */

#include "exl.h"

#include <time.h>

#define symbol_char_p(ch)	(symbol_set[(ch) >> 5] & (1 << ((ch) & 31)))
#define space_p(ch)		(spaces_set[(ch) >> 5] & (1 << ((ch) & 31)))

#define macro_skip_line()						\
    for (ch = macro_skip(); ch != eof && ch != '\n'; ch = macro_skip())

#define macro_consume()							\
    do {								\
	if (macro_lah_token != tok_eof)					\
	    macro_lah_token = tok_eof;					\
	else								\
	    macro_cond_error();						\
    } while (0)

#define macro_state_inc()						\
    do {								\
	if (++macro_state->offset >= macro_state->length)				\
	    erenew_vector(macro_state, macro_state->length + 256);	\
    } while (0)

#define macro_get_else()	(macro_state->v.i8[macro_state->offset] &  1)
#define macro_set_else()	 macro_state->v.i8[macro_state->offset] |= 1
#define macro_get_true()	(macro_state->v.i8[macro_state->offset] &  2)
#define macro_set_true()	 macro_state->v.i8[macro_state->offset] |= 2
#define macro_get_skip()	(macro_state->v.i8[macro_state->offset] &  4)
#define macro_set_skip()	 macro_state->v.i8[macro_state->offset] |= 4
#define macro_clr_bits()	 macro_state->v.i8[macro_state->offset]  = 0

/*
 * Types
 */
typedef enum {
    mac_define,
    mac_undef,
    mac_include,
    mac_if,
    mac_ifdef,
    mac_ifndef,
    mac_elif,
    mac_else,
    mac_endif,
    mac_error,
    mac_warning,
} macro_t;

typedef struct escan {
    eint32_t	 width;
    eint32_t	 radix;
    eint32_t	 read : 1;
    eint32_t	 skip : 1;
    eint32_t	 uppr : 1;
    eint32_t	 set[256 / 4];
} escan_t;

/*
 * Prototypes
 */
static eint32_t
scan_obj(estream_t *stream, escan_t *scan);

static eint32_t
getc_quoted(estream_t *stream);

static eint32_t
scan_chr(estream_t *stream);

static eint32_t
scan_chr_len(estream_t *stream, eint32_t len, ebool_t uppr);

static eint32_t
scan_str(estream_t *stream);

static eint32_t
scan_str_set(estream_t *stream, eint32_t *set, eint32_t width);

static eint32_t
scan_num(estream_t *stream, eint32_t radix, eint32_t ch, ebool_t uppr);

static etype_t
scan_num_real(estream_t *stream, eint32_t radix, eint32_t ch, ebool_t uppr);

static etype_t
scan_num_radix(estream_t *stream, eint32_t radix, ebool_t uppr);

static void
builtin_scan(eint32_t ac);

static void
builtin_scanf(eint32_t ac);

static void
builtin_scan_impl(eint32_t ac, ebool_t file);

static eint32_t
getc_noeof(void);

static eint32_t
skip(void);

static eint32_t
macro_skip(void);

static eint32_t
skip_comment(void);

static eobject_t
read_object(void);

static eobject_t
macro_object(ebool_t define);

static eobject_t
macro_date(void);

static eobject_t
macro_time(void);

static evector_t *
read_ident(eint32_t ch);

static eobject_t
macro_ident(void);

static void
macro_check(void);

static void
macro_ignore(void);

static etoken_t
macro_primary(eobject_t *object);

static etoken_t
macro_lookahead(void);

static etoken_t
macro_unary(eobject_t *object);

static etoken_t
macro_muldivrem(eobject_t *object);

static etoken_t
macro_addsub(eobject_t *object);

static etoken_t
macro_shift(eobject_t *object);

static etoken_t
macro_bitop(eobject_t *object);

static etoken_t
macro_logcmp(eobject_t *object);

static etoken_t
macro_logop(eobject_t *object);

static void
macro_defined(eobject_t object);

static void
macro_cond_error(void) noreturn;

static ebool_t
macro_cond(void);

static emacro_t *
macro_define(esymbol_t *name);

static eobject_t
macro_string(eobject_t object);

static eobject_t
macro_function(emacro_t *macro, eobject_t *alist,
	       eobject_t *elist, eobject_t vlist);

static void
macro_evaluate(eint32_t count, eentry_t *entry,
	       eobject_t *alist, eobject_t *elist);

static eobject_t
macro_expand(emacro_t *macro);

static eobject_t
macro_read(void);

static eobject_t
read_character(void);

static evector_t *
read_string(void);

static eobject_t
read_number(eint32_t ch);

static eobject_t
read_symbol(eint32_t ch);

static eobject_t
read_keyword(eint32_t ch);

static eint32_t
char_value(eint32_t ch, int base);

/*
 * Initialization
 */
static struct {
    char	*name;
    macro_t	 macro;
} macros[] = {
    { "define",		mac_define	},
    { "undef",		mac_undef	},
    { "include",	mac_include	},
    { "if",		mac_if		},
    { "ifdef",		mac_ifdef	},
    { "ifndef",		mac_ifndef	},
    { "elif",		mac_elif	},
    { "else",		mac_else	},
    { "endif",		mac_endif	},
    { "error",		mac_error	},
    { "warning",	mac_warning	},
};

/* macro globals */
static ehash_t	 *ht_preprocessor;
static ehash_t	 *ht_defines;		/* definitions */
static ehash_t	 *expand_hash;		/* being expanded */
static evector_t *macro_state;		/* state of conditional nesting */
static evector_t *macro_name;		/* conditional starting name */
static eint32_t	  macro_line;		/* conditional starting line */
static eint32_t	  macro_counter;	/* __COUNTER__ value */
static ebool_t	  macro_conditional;	/* return 0 instead of reading next
					 * token, when evaluating macro
					 * without value, if set,
					 * used by #if and #elif */

static eobject_t  object_list;		/* macro expansion result */
static eobject_t  object_limit;		/* used when evaluating macro
					 * arguments, to only allow
					 * reading from object_list,
					 * and not from input stream */
static eobject_t  defined;		/* special macro symbol */
static eobject_t  macro_lah_value;
static etoken_t	  macro_lah_token;
static eint32_t	  macro_cond_line;

static eint32_t	  spaces_set[256 / 4];
static eint32_t	  string_set[256 / 4];
static eint32_t	  symbol_set[256 / 4];

static eobject_t *input_list;
estream_t	 *input;
eobject_t	  object_eof;

/*
 * Implementation
 */
void
init_read(void)
{
    eint32_t	 i;
    char	*s;
    eentry_t	*entry;
    esymbol_t	*symbol;

    /* preprocessor identifiers */
    enew_hash((eobject_t *)&ht_preprocessor, H_pointer, 11);
    eadd_root((eobject_t *)&ht_preprocessor);

    /* macro definitions */
    enew_hash((eobject_t *)&ht_defines, H_pointer, 11);
    eadd_root((eobject_t *)&ht_defines);

    /* macro expansions */
    enew_hash((eobject_t *)&expand_hash, H_pointer, 5);
    eadd_root((eobject_t *)&expand_hash);

    eadd_root((eobject_t *)&input_list);

    /* macro expansion object list */
    eadd_root((eobject_t *)&object_list);

    /* conditional state bits */
    evector(&macro_state, t_int8, 256, 1);
    eadd_root((eobject_t *)&macro_state);

    eadd_root((eobject_t *)&macro_name);

    /* ensure it does not match any valid object */
    object_eof = enew_symbol(ht_language, eget_string((euint8_t *)"*eof*", 5));

    defined = enew_symbol(ht_language, eget_string((euint8_t *)"defined", 7));

    v_check(1);
    v_push(null);
    for (i = 0; i < esize(macros); i++) {
	enew(&entry, entry);
	v_top() = entry;
	entry->name = enew_symbol(ht_language,
				  eget_string((euint8_t *)macros[i].name,
					      strlen(macros[i].name)));
	entry->value = efixnum(macros[i].macro);
	eput_hash(ht_preprocessor, entry);
    }
    v_dec();

    memset(string_set, 0xff, sizeof(string_set));
    for (s = " \t\r\n\f\v"; *s; s++) {
	spaces_set[*s >> 5] |= 1 << (*s & 31);
	string_set[*s >> 5] &= ~(1 << (*s & 31));
    }

    for (s = "abcdefghijklmnopqrstuvwxyz_"
	 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
	 *s; s++)
	symbol_set[*s >> 5] |= 1 << (*s & 31);

    symbol = enew_symbol(ht_language, eget_string((euint8_t *)"scan", 4));
    edefine_builtin(enew_bound_symbol(symbol), builtin_scan, 1, true);

    symbol = enew_symbol(ht_language, eget_string((euint8_t *)"scanf", 5));
    edefine_builtin(enew_bound_symbol(symbol), builtin_scanf, 1, true);
}

eobject_t
eread_object(void)
{
    eobject_t	object;

    if (input) {
	for (;;) {
	    if ((object = read_object()) != object_eof)
		return (object);
	    if (input != std_input)
		eclose(input);
	    if ((input_list = ecdr(input_list)))
		input = ecar(input_list);
	    else
		break;
	}
    }
    if (macro_state->offset > 0)
	eread_error(null,
		    "unfinished conditional starting at %p:%d",
		    macro_name, macro_line);

    return (object_eof);
}

void
epush_input(estream_t *stream)
{
    input_list = econs(stream, input_list);
    input = stream;
}

static eint32_t
scan_obj(estream_t *stream, escan_t *scan)
{
    eint32_t	ch;
    eint32_t	count;
    eint32_t	width;
    eint32_t	bytes;
    eint32_t	offset;
    ebool_t	stream_p;

    bytes = count = 0;
    switch (eobject_type(stream) & ~t_const) {
	case t_stream:
	    eread_lock(stream);
	    stream_p = true;
	    break;
	case t_string:
	    stream_p = false;
	    break;
	default:
	    thread_self->except = except_invalid_argument;
	    return (-1);
    }
    offset = stream->offset;

    if ((width = scan->width) < 0)
	width = 0;

    /* if must skip whitespaces */
    if (scan->skip) {
	/* '%c' doesn't skip spaces */
	if (scan->read || scan->radix != 256) {
	    for (ch = egetc(stream);
		 ch != eof && space_p(ch); ch = egetc(stream))
		++bytes;
	    eungetc(stream, ch);
	}

	switch (scan->radix) {
	    case -1:
		switch (ch) {
		    case '+': case '-':
			count = egetc(stream);
			/* check if a digit follows sign character */
			if (count < '0' || count > '9') {
			    eungetc(stream, count);
			    eungetc(stream, ch);
			    count = 0;
			    goto scan_str;
			}
		    case '0'...'9':
			scan->read = 1;
			goto scan_num;
		    case '\'':
			scan->read = 1;
			goto scan_chr;
		    case '"':
			scan->read = 1;
			goto scan_str;
		    default:
			eungetc(stream, ch);
			goto scan_str;
		}
		break;
	    case 2: case 8: case 10: case 16:
	    scan_num:
		/* number */
		if ((ch = egetc(stream)) == eof)
		    goto done;
		/* this silently allows reading in another base
		 * what should be the expected behavior, as the
		 * read sequence must match the language format */
		if (scan->read)
		    count = scan_num(stream, 0, ch, false) + 1;
		else
		    /* scan.uppr reads a t_mpr if would default to float */
		    count = scan_num(stream, scan->radix, ch, scan->uppr) + 1;
		if (count < 0)
		    goto done;
		bytes += count;
		break;
	    case 256:
	    scan_chr:
		/* character */
		if (scan->read) {
		    if (egetc(stream) != '\'' ||
			(count = scan_chr(stream)) <= 0)
			goto done;
		    bytes += count + 2;
		}
		else {
		    if (width <= 0)	width = 1;
		    if ((count = scan_chr_len(stream, width, scan->uppr)) <= 0)
			goto done;
		    bytes += count;
		}
		break;
	    default:
	    scan_str:
		/* string */
		if (scan->read) {
		    if (egetc(stream) != '"' ||
			(count = scan_str(stream)) == eof)
			goto done;
		    bytes += count + 2;
		}
		else {
		    count = scan_str_set(stream, string_set, width);
		    if (count >= 0)
			bytes += count;
		}
	}
    }
    /* character sets don't skip whitespaces */
    else if ((count = scan_str_set(stream, scan->set, width)) >= 0)
	bytes += count;

done:
    if (bytes <= 0)
	stream->offset = offset;
    if (stream_p)
	eread_unlock(stream);

    return (bytes);
}

static eint32_t
getc_quoted(estream_t *stream)
{
    eint32_t	i;
    eint32_t	ch;
    eint32_t	digit;
    eint32_t	value;
    eint32_t	quote;

    quote = 0;
    ch = egetc(stream);
    if (ch == '\\') {
	quote = 1;
	ch = egetc(stream);
	switch (ch) {
	    case 'a': ch = '\a'; break;
	    case 'b': ch = '\b'; break;
	    case 'f': ch = '\f'; break;
	    case 'n': ch = '\n'; break;
	    case 'r': ch = '\r'; break;
	    case 't': ch = '\t'; break;
	    case 'v': ch = '\v'; break;
	    case '"': case '\'': break;
	    case '0': case '1': case '2':
		value = egetc(stream);
		digit = char_value(value, 8);
		if (digit != eof) {
		    ch = digit;
		    for (i = 1; i < 2; i++) {
			value = egetc(stream);
			digit = char_value(value, 8);
			if (digit != eof) {
			    ch = (ch << 3) | digit;
			    if (ch > 255)
				break;
			}
			else {
			    (void)eungetc(stream, value);
			    break;
			}
		    }
		}
		else
		    (void)eungetc(stream, value);
		break;
	    case 'x':
		value = egetc(stream);
		digit = char_value(value, 16);
		if (digit != eof) {
		    ch = digit;
		    for (i = 0; i < 2; i++) {
			value = egetc(stream);
			digit = char_value(value, 16);
			if (digit != eof)
			    ch = (ch << 4) | digit;
			else {
			    (void)eungetc(stream, value);
			    break;
			}
		    }
		}
		else
		    (void)eungetc(stream, value);
		break;
	    case '\n':
		quote = 0;
		ch = getc_quoted(stream);
		break;
	}
    }

    return (quote ? ch | 0x100 : ch);
}

static eint32_t
scan_chr(estream_t *stream)
{
    eint32_t	ch;
    eint32_t	bytes;

    bytes = 0;
    thread_self->ret.v.i = 0;
    thread_self->ret.t = t_int;
    for (ch = getc_quoted(stream);
	 ch != eof && ch != '\'';
	 ch = getc_quoted(stream)) {
#if NEWLINE_NEEDS_BACKSLASH
	if (ch == '\n')
	    return (eof);
#endif
	if (bytes < 8)
	    thread_self->ret.v.i = (thread_self->ret.v.i << 8) | (ch & 0xff);
	else {
	    if (bytes == 8) {
		empz_set_u(thr_zr, thread_self->ret.v.i);
		thread_self->ret.t = t_mpz;
	    }
	    mpz_mul_2exp(thr_zr, thr_zr, 8);
	    mpz_add_ui(thr_zr, thr_zr, ch & 0xff);
	}
	++bytes;
    }
    if (bytes == 8 && empz_fit_i(thr_zr)) {
	thread_self->ret.v.i = empz_get_i(thr_zr);
	thread_self->ret.t = t_int;
    }

    return (ch != eof ? bytes : eof);
}

static eint32_t
scan_chr_len(estream_t *stream, eint32_t len, ebool_t uppr)
{
    eint32_t	ch;
    eint32_t	bytes;

    bytes = 0;
    thread_self->ret.v.i = 0;
    thread_self->ret.t = t_int;
    for (ch = egetc(stream); ch != eof && len; ch = egetc(stream), --len) {
	if (bytes < 8)
	    thread_self->ret.v.i = (thread_self->ret.v.i << 8) | (ch & 0xff);
	else {
	    if (bytes == 8) {
		empz_set_u(thr_zr, thread_self->ret.v.i);
		thread_self->ret.t = t_mpz;
	    }
	    mpz_mul_2exp(thr_zr, thr_zr, 8);
	    mpz_add_ui(thr_zr, thr_zr, ch & 0xff);
	}
	++bytes;
    }
    if (bytes == 8 && empz_fit_i(thr_zr)) {
	thread_self->ret.v.i = empz_get_i(thr_zr);
	thread_self->ret.t = t_int;
    }
    else if (bytes == 1 && uppr && thread_self->ret.v.i > 127)
	thread_self->ret.v.i -= 256;

    return (bytes);
}

static eint32_t
scan_str(estream_t *stream)
{
    eint32_t	 ch;
    eint32_t	 size;
    eint32_t	 length;
    euint8_t	*string;

    length = 0;
    string = thread_self->vec->v.u8;
    size = eobject_length(string);

    for (ch = getc_quoted(stream);
	 ch != eof && ch != '"';
	 ch = getc_quoted(stream)) {
#if NEWLINE_NEEDS_BACKSLASH
	if (ch == '\n')
	    return (eof);
#endif
	if (length >= size) {
	    size += BUFSIZ;
	    size += BUFSIZ - (size % BUFSIZ);
	    if (size < 0 || size < length) {
		thread_self->except = except_out_of_bounds;
		goto done;
	    }
	    eresize_object(&thread_self->vec->v.obj, size);
	    string = thread_self->vec->v.u8;
	}
	string[length++] = ch;
    }
    if (ch != eof) {
	thread_self->ret.t = t_string;

	return (thread_self->vec->length = length);
    }

done:
    return (eof);
}

static eint32_t
scan_str_set(estream_t *stream, eint32_t *set, eint32_t width)
{
    eint32_t	 ch;
    eint32_t	 size;
    eint32_t	 length;
    euint8_t	*string;

    length = 0;
    string = thread_self->vec->v.u8;
    size = eobject_length(string);

    for (ch = egetc(stream);
	 ch != eof && (set[ch >> 5] & (1 << (ch & 31)));
	 ch = egetc(stream)) {
	if (length >= size) {
	    size += BUFSIZ;
	    size += BUFSIZ - (size % BUFSIZ);
	    if (size < 0 || size < length) {
		thread_self->except = except_out_of_bounds;
		goto done;
	    }
	    eresize_object(&thread_self->vec->v.obj, size);
	    string = thread_self->vec->v.u8;
	}
	string[length++] = ch;
	if (width && !--width)
	    break;
    }

    if (ch != eof || length) {
	thread_self->ret.t = t_string;

	return (thread_self->vec->length = length);
    }

done:
    return (eof);
}

static eint32_t
scan_num(estream_t *stream, eint32_t radix, eint32_t ch, ebool_t uppr)
{
    eint32_t	base;
    etype_t	type;
    eint32_t	offset;

    /* save initial state in case need to rollback read state */
    base = offset = stream->offset;
    thread_self->vec->length = thread_self->vec->offset = 0;

    /* check for real number specification */
    if ((type = scan_num_real(stream, radix, ch, uppr)) == t_void) {

	/* failed to read a number */
	thread_self->ret.t = t_void;
	thread_self->vec->length = thread_self->vec->offset = 0;
	stream->offset = offset;
	return (-1);
    }

    thread_self->ret.t = type;
    return (stream->offset - base);
}

static etype_t
scan_num_real(estream_t *stream, eint32_t radix, eint32_t ch, ebool_t uppr)
{
    euint8_t	*ptr;
    eint32_t	 length;

    /* point from where to parse number specification */
    thread_self->vec->offset = thread_self->vec->length;

    /* don't check bounds in up to 3 bytes */
    length = eobject_length(thread_self->vec->v.obj);
    if (length - thread_self->vec->length <= 3)
	eresize_object(&thread_self->vec->v.obj, length + BUFSIZ);
    ptr = thread_self->vec->v.u8;

    if (ch == '-' || ch == '+') {
	ptr[thread_self->vec->length++] = ch;
	/* if input ends in '-' or '+' */
	if ((ch = egetc(stream)) == eof) {
	    eungetc(stream, ptr[thread_self->vec->length - 1]);
	    return (t_void);
	}
    }

    /* if need to figure radix */
    if (radix == 0) {
	radix = 10;
	if (ch == '0') {
	    ch = egetc(stream);
	    switch (ch) {
		case 'b': case 'B':
		    radix = 2;
		    break;
		case 'x': case 'X':
		    radix = 16;
		    break;
		case '0'...'7':
		    radix = 8;
		    ptr[thread_self->vec->length++] = ch;
		    break;
		default:
		    ptr[thread_self->vec->length++] = '0';
		    eungetc(stream, ch);
		    break;
	    }
	}
	else {
	    if (ch < '1' || ch > '9') {
		if (ch == '.')
		    eungetc(stream, ch);
		else
		    return (t_void);
	    }
	    else
		ptr[thread_self->vec->length++] = ch;
	}
    }
    else {
	if (ch == '.')
	    eungetc(stream, ch);
	else
	    ptr[thread_self->vec->length++] = ch;
    }

    return (scan_num_radix(stream, radix, uppr));
}

static etype_t
scan_num_radix(estream_t *stream, eint32_t radix, ebool_t uppr)
{
    eint32_t	 ch;
    eint32_t	 ech;
    ebool_t	 done;
    etype_t	 type;
    eint32_t	 state;
    eint32_t	 length;
    char	*string;

#define has_dot			(1 << 0)
#define has_exponent		(1 << 1)
#define has_sign		(1 << 2)
#define has_modifier		(1 << 3)
    ech = 0;
    state = 0;
    done = false;
    type = t_void;
    string = thread_self->vec->v.obj;
    length = eobject_length(thread_self->vec->v.u8);

    for (ch = egetc(stream); ch != eof; ch = egetc(stream)) {
	switch (ch) {
	    case '.':
		done = state & (has_dot|has_exponent);
		state |= has_dot;
		break;
	    case 'e': case 'E':
		if (radix == 16)
		    break;
		ech = ch;
		ch = 'e';
		done = state & has_exponent;
		state |= has_exponent;
		break;
	    case '@':
		ech = ch;
		done = state & has_exponent;
		state |= has_exponent;
		break;
	    case '+': case '-':
		done = (state & has_sign) || !(state & has_exponent);
		if (!done) {
		    state |= has_sign;
		    if (string[thread_self->vec->length - 1] != '@')
			done = radix > 10 ||
			    string[thread_self->vec->length - 1] != 'e';
		}
		break;
	    case '0'...'1':				break;
	    case '2'...'7':	done = radix < 8;	break;
	    case '8'...'9':	done = radix < 10;	break;
	    case 'A'...'D':	case 'F':
	    case 'a'...'d':	case 'f':
				done = radix < 16;	break;
	    default:		done = true;		break;
	}

	if (done) {
	    switch (ch) {
		case 'l': case 'L':
		    state |= has_modifier;
		    type = t_mpr;
		    break;
		default:
		    eungetc(stream, ch);
	    }
	    if ((state & has_exponent) &&
		string[thread_self->vec->length - 1] == ech) {
		eungetc(stream, ech);
		state &= ~has_exponent;
	    }
	    else if ((state & has_dot) &&
		     string[thread_self->vec->length - 1] == '.') {
		/* allow trailing dot for floats */
		if ((ch = egetc(stream)) == '.') {
		    /* two sequential dots should be ellipsis in case range */
		    eungetc(stream, '.');
		    eungetc(stream, '.');
		    state &= ~has_dot;
		}
		else
		    eungetc(stream, ch);
	    }
	    break;
	}

	if (thread_self->vec->length + 1 >= length) {
	    length += BUFSIZ;
	    length += BUFSIZ - (length % BUFSIZ);
	    if (length < 0 || length < thread_self->vec->length) {
		thread_self->except = except_out_of_bounds;
		type = t_void;
		goto done;
	    }
	    eresize_object(&thread_self->vec->v.obj, length);
	    string = thread_self->vec->v.obj;
	}
	string[thread_self->vec->length++] = ch;
    }

    string[thread_self->vec->length] = '\0';
    string += thread_self->vec->offset;
    if (string[0] == '+')
	++string;

    if (type == t_void && (state & (has_dot | has_exponent)))
	type = uppr ? t_mpr : t_float;

    switch (type) {
	case t_mpr:
	    mpfr_set_str(thr_rr, string, radix, thr_rnd);
 	    break;
	case t_float:
	    mpfr_set_str(thr_rr, string, radix, thr_rnd);
	    thread_self->ret.v.d = mpfr_get_d(thr_rr, thr_rnd);
	    break;
	default:
	    if (thread_self->vec->length - thread_self->vec->offset) {
		errno = 0;
#if __WORDSIZE == 32
		thread_self->ret.v.i = strtoll(string, null, radix);
#else
		thread_self->ret.v.i = strtol(string, null, radix);
#endif
		if (errno == ERANGE) {
		    mpz_set_str(thr_zr, string, radix);
		    type = t_mpz;
		}
		else
		    type = t_int;
	    }
	    break;
    }

    /* could also check if is scanning a rational */
    if (state & has_modifier)
	thread_self->vec->v.u8[thread_self->vec->length++] = ch;

#undef has_dot
#undef has_exponent
#undef has_sign
#undef has_modifier

done:
    return (type);
}

static void
builtin_scan(eint32_t ac)
{
    builtin_scan_impl(ac, false);
}

static void
builtin_scanf(eint32_t ac)
{
    builtin_scan_impl(ac, true);
}

static void
builtin_scan_impl(eint32_t ac, ebool_t file)
{
    evalue_t	*a;
    evector_t	*v;
    eint64_t	 i;
    eint32_t	 c;
    eint32_t	 ai;
    ebool_t	 prec;
    escan_t	 scan;
    ebool_t	 argp;
    eint32_t	 bytes;
    eint32_t	 count;
    ebool_t	 ignore;
    estream_t	*stream;
    ebool_t	 include;
    ebool_t	 stream_p;
    euint8_t	*t, *l;

#define next_argument()							\
    do {								\
	if (argp)							\
	    argp = false;						\
	else {								\
	    if (++ai >= ac)						\
		goto done;						\
	    --a;							\
	}								\
    } while (0)

#define position_argument(n)						\
    do {								\
	if (n < 0 || n >= ac)						\
	    goto done;							\
	ai = n;								\
	a = thread_self->esp - ai - 1;					\
	if (file) --a;							\
	argp = true;							\
    } while (0)

    a = thread_self->esp - 1;
    if (file) {
	ai = 1;
	switch (a->t & ~t_const) {
	    case t_string:
		stream = a->v.o;
		stream_p = false;
		stream->offset = 0;
		break;
	    case t_stream:
		stream = a->v.o;
		stream_p = true;
		if (!stream->s_read)
		    ethrow(except_invalid_argument);
		emutex_lock(&stream->mutex);
		break;
	    default:
		ethrow(except_invalid_argument);
	}
	--a;
    }
    else {
	ai = 0;
	stream = std_input;
	emutex_lock(&stream->mutex);
	stream_p = true;
    }
    argp = false;	/* positional argument */
    v = a->v.o;
    switch (a->t & ~t_const) {
	case t_string:
	    break;
	default:
	    ethrow(except_type_mismatch);
    }
    t = v->v.u8;
    l = t + v->length;

    ignore = false;
    bytes = count = 0;
    while (t < l) {
	/* skip explicit whitespaces */
	if (space_p(*t)) {
	    do {
		if (++t >= l)			break;
	    } while (space_p(*t));

	    if ((c = egetc(stream)) == eof)	goto match;
	    if (space_p(c)) {
		++bytes;
		do {
		    if ((c = egetc(stream)) == eof)
			/* a %n format may follow */
			goto match;
		    ++bytes;
		} while (space_p(c));
	    }
	    eungetc(stream, c);
	    --bytes;
	}

    match:
	if (t >= l)				break;
	if (*t != '%') {
	    if ((c = egetc(stream)) == eof)	break;
	    ++bytes;
	    if (c != *t)			break;
	    ++t;
	    continue;
	}

	prec = false;
	scan.read = 0;
	scan.skip = 1;
	scan.uppr = 0;
	scan.width = 0;

    again:
	if (++t >= l)				break;
    check:
	switch (*t) {
	    case '%':
		if (egetc(stream) != '%')	goto done;
		++bytes;
		break;
	    case '#':				scan.read = true;
		goto again;
	    case '*':				ignore = true;
		goto again;

		/* make it easy to use same format
		 * string as argument to print and scan */
	    case '.':				prec = true;
	    case '-':				goto again;

	    case '0'...'9':
		i = 0;
		do {
		    if (i < most_positive_fixnum)
			i = i * 10 + (*t - '0');
		    if (++t >= l)		goto done;
		} while (*t >= '0' && *t <= '9');
		if (*t == '$') {
		    /* should fail if i == 0 as argument is not a pointer */
		    position_argument(i);
		    ++t;
		}
		else if (!prec)			scan.width = i;
		goto check;
	    case 'B':				scan.uppr = 1;
	    case 'b':				scan.radix = 2;
		goto scan_object;
	    case 'O':				scan.uppr = 1;
	    case 'o':				scan.radix = 8;
		goto scan_object;
	    case 'D':case 'E':case 'F':case 'G':scan.uppr = 1;
	    case 'd':case 'e':case 'f':case 'g':scan.radix = 10;
		goto scan_object;
	    case 'X':				scan.uppr = 1;
	    case 'x':				scan.radix = 16;
		goto scan_object;
	    case 'C':				scan.uppr = 1;
	    case 'c':				scan.radix = 256;
		goto scan_object;

	    case '[':
#define set_bit(n)							\
    if (include)	scan.set[n >> 5] |= 1 << (n & 31);		\
    else		scan.set[n >> 5] &= ~(1 << (n & 31))
		if (++t >= l)			goto done;
		if ((include = *t != '^'))
		    memset(scan.set, 0, sizeof(scan.set));
		else {
		    memset(scan.set, 0xff, sizeof(scan.set));
		    if (++t >= l)		goto done;
		}
		do {
		    c = *t;
		    set_bit(c);
		    if (++t >= l)		goto done;
		    if (*t == '-') {
			if (++t >= l)		goto done;
			if (*t == ']') {
			    set_bit('-');
			    break;
			}
			for (++c; c < *t; c++) {
			    set_bit(c);
			}
		    }
		} while (*t != ']');
		scan.skip = 0;
		goto scan_object;

	    case 'n':
		next_argument();
		if (ignore) {
		    ignore = false;
		    break;
		}
		thread_self->ret.v.i = bytes;
		thread_self->ret.t = t_int;
		ebuiltin_store_pointer(a);
		break;

		/* try to guess object type */
	    case 'A':				scan.uppr = 1;
	    case 'a':				scan.radix = -1;
		goto scan_object;

	    case 'S':				scan.uppr = 1;
	    case 's':				scan.radix = 0;
	    scan_object:
		if ((c = scan_obj(stream, &scan)) <= 0)
		    goto done;
		bytes += c;

		if (ignore) {
		    ignore = false;
		    break;
		}

		next_argument();
		ebuiltin_store_pointer(a);
		++count;
		break;
	    default:
		if (stream_p)
		    emutex_unlock(&stream->mutex);
		ethrow(except_invalid_argument);
	}
	++t;
    }
done:
    if (stream_p)
	emutex_unlock(&stream->mutex);
    thread_self->ret.t = t_int;
    thread_self->ret.v.i = count;
}

static eint32_t
getc_noeof(void)
{
    eint32_t	ch;

    if ((ch = egetc(input)) == eof)
	eread_error(null, "unexpected end of file");

    return (ch);
}

static eint32_t
skip(void)
{
    eint32_t	ch;

    for (ch = egetc(input); ; ch = egetc(input)) {
	if (ch == '/')
	    ch = skip_comment();
	switch (ch) {
	    case '\n':
	    case ' ':	case '\t':
	    case '\r':	case '\v':	case '\f':
		break;
	    default:
		return (ch);
	}
    }
}

/* don't ignore newlines and handle backslashes */
static eint32_t
macro_skip(void)
{
    eint32_t	ch;

    for (ch = egetc(input); ; ch = egetc(input)) {
	if (ch == '/')
	    ch = skip_comment();
	switch (ch) {
	    case '\n':
		return (ch);
	    case ' ':	case '\t':
	    case '\r':	case '\v':	case '\f':
		break;
	    case '\\':
		ch = egetc(input);
		if (ch == eof)
		    eread_error(null, "unexpected end of input");
		else if (ch != '\n') {
		    eungetc(input, ch);
		    return ('\\');
		}
		break;
	    default:
		return (ch);
	}
    }
}

static eint32_t
skip_comment(void)
{
    eint32_t	ch;
    ebool_t	line;
    eint32_t	nest;

    /* this function is called after reading a '/' */
    ch = egetc(input);
again:
    switch (ch) {
	case '/':
	    line = true;
	    for (ch = egetc(input); ch != '\n' && ch != eof; ch = egetc(input))
		;
	    break;
	case '*':
	    line = false;
	    for (nest = 1; nest > 0;) {
		while ((ch = getc_noeof()) != '*') {
		    if (ch == '/') {
			if (getc_noeof() == '*')
			    ++nest;
		    }
		}
		while ((ch = getc_noeof()) == '*')
		    ;
		if (ch == '/')
		    --nest;
	    }
	    ch = egetc(input);
	    break;
	default:
	    /* not a comment */
	    eungetc(input, ch);
	    return ('/');
    }

    /* return ending '\n' */
    if (line && ch == '\n') {
	/* fast check for multiple comments */
	if ((nest = egetc(input)) == '/') {
	    ch = egetc(input);
	    if (ch == '/' || ch == '*')
		goto again;
	    eungetc(input, ch);
	    eungetc(input, nest);
	    return ('\n');
	}
	else
	    eungetc(input, nest);
    }

    return (ch);
}

static eobject_t
read_object(void)
{
    eint32_t	 ch;
    emacro_t	*macro;
    eobject_t	 object;

    if (object_list) {
	if (object_list == object_limit)
	    object = object_eof;
	else {
	    object = ecar(object_list);
	    object_list = ecdr(object_list);
	    if (esymbol_p(object) &&
		(macro = (emacro_t *)eget_hash(ht_defines, object)))
		object = macro_expand(macro);
	}
    }
    else {
	if (object_limit) {
	    object = object_limit;
	    goto done;
	}
	if (expand_hash->count)
	    eclr_hash(expand_hash);
	switch ((ch = skip())) {
	    case eof:		object = object_eof;		break;
	    case '#':		object = macro_read();		break;
	    case '"':		object = read_string();		break;
	    case '\'':		object = read_character();	break;
	    case '0'...'9':	object = read_number(ch);	break;
	    case 'a'...'z': case 'A'...'Z': case '_':
		object = read_symbol(ch);
		if ((macro = (emacro_t *)eget_hash(ht_defines, object)))
		    object = macro_expand(macro);
		break;
	    case '.':
		/* allow leading dot for floats */
		ch = egetc(input);
		if (ch >= '0' && ch <= '9') {
		    eungetc(input, ch);
		    object = read_number('.');
		    break;
		}
		eungetc(input, ch);
		ch = '.';
	    default:		object = read_keyword(ch);	break;
	}
    }

done:
    return (object);
}

static eobject_t
macro_object(ebool_t define)
{
    eint32_t	ch;
    eobject_t	object;

    if (object_list) {
	object = ecar(object_list);
	object_list = ecdr(object_list);
    }
    else {
	ch = define ? macro_skip() : skip();
	switch (ch) {
	    case '\n':
	    case eof:	object = object_eof;			break;
	    case '"':	object = read_string();			break;
	    case '\'':	object = read_character();		break;
	    case '0'...'9':	object = read_number(ch);	break;
	    case 'a'...'z': case 'A'...'Z': case '_':
		object = read_symbol(ch);			break;
	    case '.':
		/* allow leading dot for floats */
		ch = egetc(input);
		if (ch >= '0' && ch <= '9') {
		    eungetc(input, ch);
		    object = read_number('.');
		    break;
		}
		eungetc(input, ch);
		ch = '.';
	    default:	object = read_keyword(ch);		break;
	}
    }

    return (object);
}

/* adapted from <gcc-base>/libcpp/macro.c:_cpp_builtin_macro_text(),
 * but instead of having a static global value, recalculate it everytime
 * the macro is expanded, so it can be used to measure compile time
 * (in seconds resolution) */
static eobject_t
macro_date(void)
{
    eformat_t	 format;
    eobject_t	 object;
    estream_t	*stream;
    struct tm	*macro_tm;
    time_t	 macro_time;
    static const char *const monthnames[] = {
	"Jan", "Feb", "Mar", "Apr", "May", "Jun",
	"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
    };

    errno = 0;
    macro_tm = null;
    macro_time = time(null);
    if (macro_time != (time_t)-1 || errno == 0)
	macro_tm = localtime(&macro_time);

    stream = (estream_t *)tmain->vec;
    if (macro_tm) {
	memset(&format, 0, sizeof(eformat_t));
	format.width = 2;
	format.radix = 10;
	memcpy(stream->ptr, monthnames[macro_tm->tm_mon], 3);
	stream->ptr[3] = ' ';
	stream->offset = stream->length = 4;
	eprint_int(stream, &format, macro_tm->tm_mday);
	stream->ptr[6] = ' ';
	stream->offset = stream->length = 7;
	eprint_int(stream, &format, macro_tm->tm_year + 1900);
	object = eget_string(stream->ptr, stream->length);
    }
    else {
	eread_warn(null, "could not determine date");
	object = eget_string((euint8_t *)"??? ?? ????", 11);
    }

    return (object);
}

static eobject_t
macro_time(void)
{
    eformat_t	 format;
    eobject_t	 object;
    estream_t	*stream;
    struct tm	*macro_tm;
    time_t	 macro_time;

    errno = 0;
    macro_tm = null;
    macro_time = time(null);
    if (macro_time != (time_t)-1 || errno == 0)
	macro_tm = localtime(&macro_time);

    stream = (estream_t *)tmain->vec;
    if (macro_tm) {
	memset(&format, 0, sizeof(eformat_t));
	format.zero = 1;
	format.width = 2;
	format.radix = 10;
	stream->offset = stream->length = 0;
	eprint_int(stream, &format, macro_tm->tm_hour);
	stream->ptr[2] = ':';
	stream->offset = stream->length = 3;
	eprint_int(stream, &format, macro_tm->tm_min);
	stream->ptr[5] = ':';
	stream->offset = stream->length = 6;
	eprint_int(stream, &format, macro_tm->tm_sec);
	object = eget_string(stream->ptr, stream->length);
    }
    else {
	eread_warn(null, "could not determine time");
	object = eget_string((euint8_t *)"??:??:??", 8);
    }

    return (object);
}

static evector_t *
read_ident(eint32_t ch)
{
    eint32_t	 size;
    eint32_t	 length;
    euint8_t	*string;
    evector_t	*vector;
    euint8_t	 buffer[BUFSIZ];
    v_enter();

    string = buffer;
    size = sizeof(buffer);
    length = 1;
    string[0] = ch;

    for (ch = egetc(input); ch != eof && symbol_char_p(ch); ch = egetc(input)) {
	if (length >= size) {
	    size += BUFSIZ;
	    if (string == buffer) {
		v_check(1);
		enew_object((eobject_t *)&string, t_resize | t_uint8, size);
		v_push(string);
		memcpy(string, buffer, length);
	    }
	    else {
		eresize_object((eobject_t *)&string, size);
		v_top() = string;
	    }
	}
	string[length++] = ch;
    }
    if (ch != eof)
	eungetc(input, ch);

    vector = eget_string(string, length);
    v_leave();

    return (vector);
}

static eobject_t
macro_ident(void)
{
    eint32_t	 ch;
    evector_t	*vector;

    ch = macro_skip();
    switch (ch) {
	case eof:	eread_error(null, "unexpected end of file");
	case 'a'...'z': case 'A'...'Z': case '_':
	    vector = read_ident(ch);
	    break;
	case '\n':	eread_error(null, "expecting identifier");
	default:	eread_error(null, "'%c' is not a symbol char", ch);
    }

    return (enew_symbol(ht_language, vector));
}

static void
macro_check(void)
{
    eint32_t	ch;

    if ((ch = macro_skip()))
	eungetc(input, ch);
    else if (ch != eof)
	eread_error(null, "'%c' after preprocessor", ch);
}

static void
macro_ignore(void)
{
    eint32_t	 ch;
    eint32_t	 line;
    evector_t	*name;
    eentry_t	*entry;
    esymbol_t	*ident;

    for (ch = skip(); ch != eof; ch = skip()) {
	if (ch == '#') {
	    /* save value now, as macro_ident() may read a newline */
	    name = input->name;
	    line = input->line;
	    ident = macro_ident();
	    if ((entry = eget_hash(ht_preprocessor, ident)) == null)
		eread_error(null, "bad preprocessor '%p'", ident->name);
	    switch (eget_fixnum(entry->value)) {
		case mac_ifdef:
		case mac_ifndef:
		case mac_if:
		    macro_state_inc();
		    macro_set_skip();
		    macro_skip_line();
		    macro_ignore();
		    break;
		case mac_elif:
		    if (!macro_state->offset || macro_get_else())
			eread_error(null, "unexpected #elif");
		    else if (macro_state->offset == 1) {
			macro_name = name;
			macro_line = line;
		    }
		    if (!macro_get_true() && !macro_get_skip()) {
			if (macro_cond()) {
			    macro_set_true();
			    return;
			}
			/* dont skip line as newline was already read */
			continue;
		    }
		    break;
		case mac_else:
		    macro_check();
		    if (!macro_state->offset || macro_get_else())
			eread_error(null, "unexpected #else");
		    else if (macro_state->offset == 1) {
			macro_name = name;
			macro_line = line;
		    }
		    macro_set_else();
		    if (!macro_get_true() && !macro_get_skip()) {
			macro_set_true();
			return;
		    }
		    break;
		case mac_endif:
		    macro_clr_bits();
		    macro_check();
		    --macro_state->offset;
		    return;
		default:
		    break;
	    }
	}
	else if (ch == '"' || ch == '\'') {
	    eint32_t	quote = ch;

	    while ((ch = getc_quoted(input)) != quote) {
		if (ch == eof
#if NEWLINE_NEEDS_BACKSLASH
		    || ch == '\n'
#endif
		    )
		    eread_error(null, "expecting '\\%c'", quote);
	    }
	}
	/* skip to next line or eof */
	macro_skip_line();
    }
}

static etoken_t
macro_primary(eobject_t *object)
{
    etoken_t	 token;
    esymbol_t	*symbol;

    if (macro_lah_token != tok_eof) {
	token = macro_lah_token;
	switch ((token = macro_lah_token)) {
	    case tok_symbol: case tok_number: case tok_string:
		*object = macro_lah_value;
	    default:
		break;
	}
	macro_lah_token = tok_eof;

	return (token);
    }

    if (object_list) {
	symbol = ecar(object_list);
	object_list = ecdr(object_list);
	switch (etype(symbol) & ~t_const) {
	    case t_symbol:
		if (symbol->a_token)
		    token = eget_fixnum(symbol->value);
		else {
		    /* undefined macro */
		    token = tok_number;
		    *object = efixnum(0);
		}
		break;
	    case t_void:
		token = tok_number;
		*object = efixnum(0);
		break;
	    case t_fixnum: case t_int: case t_float:
	    case t_mpz: case t_mpq: case t_mpr:
		token = tok_number;
		*object = symbol;
		break;
	    case t_string:
		token = tok_string;
		*object = symbol;
		break;
	    default:
		macro_cond_error();
	}
    }
    else {
	token = tok_eof;
	*object = object_eof;
    }

    return (token);
}

static etoken_t
macro_lookahead(void)
{
    if (macro_lah_token == tok_eof && macro_lah_value != object_eof)
	macro_lah_token = macro_primary(&macro_lah_value);

    return (macro_lah_token);
}

static etoken_t
macro_unary(eobject_t *object)
{
    etoken_t	token;
    evalue_t	value;
    void	(*callback)(evalue_t *);

    token = macro_primary(object);
    switch (token) {
	case tok_list:
	    token = macro_logop(object);
	    if (macro_primary(object) != tok_elist)	macro_cond_error();
	    callback = null;
	    break;
	case tok_add:
	    token = macro_unary(object);
	    if (token != tok_number)			macro_cond_error();
	    callback = null;
	    break;
	case tok_sub:	callback = enumber_neg;		break;
	case tok_not:	callback = enumber_not;		break;
	case tok_com:	callback = einteger_com;	break;
	default:	callback = null;		break;
    }

    if (callback) {
	if ((token = macro_primary(object)) != tok_number)
	    macro_cond_error();
	enumber_get(*object, &value);
	(*callback)(&value);
	*object = enumber_create(&value);
    }

    return (token);
}

#define macro_push_check(V)						\
    do {								\
	switch (V.t) {							\
	    case t_mpz: case t_mpq: case t_mpr:				\
		v_push(V.v.o);						\
	    default:							\
		break;							\
	}								\
    } while (0)

static etoken_t
macro_muldivrem(eobject_t *object)
{
    evalue_t	l, r;
    etoken_t	token;

    if ((token = macro_unary(object)) != tok_number)
	return (token);
    if (ekind_of(token = macro_lookahead()) != tok_muldivrem)
	return (tok_number);

    do {
	v_enter();

	v_check(4);
	macro_consume();
	v_push(*object);
	enumber_get(*object, &l);
	if (macro_unary(object) != tok_number)		macro_cond_error();
	v_push(*object);
	enumber_get(*object, &r);
	enumber_coerce(&l, &r);
	macro_push_check(l);
	macro_push_check(r);
	switch (token) {
	    case tok_mul:	enumber_mul(&l, &r);	break;
	    case tok_div:	enumber_div(&l, &r);	break;
	    case tok_trunc2:	enumber_trunc2(&l, &r);	break;
	    default:		enumber_rem(&l, &r);	break;
	}
	*object = enumber_create(&l);
	v_leave();
    } while (ekind_of(token = macro_lookahead()) == tok_muldivrem);

    return (tok_number);
}

static etoken_t
macro_addsub(eobject_t *object)
{
    evalue_t	l, r;
    etoken_t	token;

    if ((token = macro_muldivrem(object)) != tok_number)
	return (token);
    if (ekind_of(token = macro_lookahead()) != tok_addsub)
	return (tok_number);

    do {
	v_enter();

	v_check(4);
	macro_consume();
	v_push(*object);
	enumber_get(*object, &l);
	if (macro_muldivrem(object) != tok_number)	macro_cond_error();
	v_push(*object);
	enumber_get(*object, &r);
	enumber_coerce(&l, &r);
	macro_push_check(l);
	macro_push_check(r);
	if (token == tok_add)	enumber_add(&l, &r);
	else			enumber_sub(&l, &r);
	*object = enumber_create(&l);
	v_leave();
    } while (ekind_of(token = macro_lookahead()) == tok_addsub);

    return (tok_number);
}

static etoken_t
macro_shift(eobject_t *object)
{
    evalue_t	l, r;
    etoken_t	token;

    if ((token = macro_addsub(object)) != tok_number)
	return (token);
    if (ekind_of(token = macro_lookahead()) != tok_shift)
	return (tok_number);

    do {
	v_enter();

	v_check(2);
	macro_consume();
	v_push(*object);
	enumber_get(*object, &l);
	if (macro_addsub(object) != tok_number)		macro_cond_error();
	v_push(*object);
	enumber_get(*object, &r);
	switch (token) {
	    case tok_mul2:	enumber_mul2(&l, &r);	break;
	    case tok_div2:	enumber_div2(&l, &r);	break;
	    case tok_shl:	enumber_shl(&l, &r);	break;
	    default:		enumber_shr(&l, &r);	break;
	}
	*object = enumber_create(&l);
	v_leave();
    } while (ekind_of(token = macro_lookahead()) == tok_shift);

    return (tok_number);
}

static etoken_t
macro_bitop(eobject_t *object)
{
    evalue_t	l, r;
    etoken_t	token;

    if ((token = macro_shift(object)) != tok_number)
	return (token);
    if (ekind_of(token = macro_lookahead()) != tok_bitop)
	return (tok_number);

    do {
	v_enter();

	v_check(4);
	macro_consume();
	v_push(*object);
	enumber_get(*object, &l);
	if (macro_shift(object) != tok_number)		macro_cond_error();
	v_push(*object);
	enumber_get(*object, &r);
	enumber_coerce(&l, &r);
	macro_push_check(l);
	macro_push_check(r);
	switch (token) {
	    case tok_and:	einteger_and(&l, &r);	break;
	    case tok_or:	einteger_or(&l, &r);	break;
	    default:		einteger_xor(&l, &r);	break;
	}
	*object = enumber_create(&l);
	v_leave();
    } while (ekind_of(token = macro_lookahead()) == tok_bitop);

    return (tok_number);
}

static etoken_t
macro_logcmp(eobject_t *object)
{
    evalue_t	l, r;
    etoken_t	token;
    etoken_t	op_token;

    if ((op_token = macro_bitop(object)) == tok_eof)
	return (tok_eof);
    if (ekind_of(token = macro_lookahead()) != tok_logcmp)
	return (op_token);

    do {
	v_enter();

	v_check(4);
	macro_consume();
	v_push(*object);
	if (op_token == tok_number)
	    enumber_get(*object, &l);
	else {
	    if (token != tok_ne && token != tok_eq)
		macro_cond_error();
	    l.t = t_int;
	    l.v.i = (eword_t)*object;
	}
	if ((op_token = macro_bitop(object)) == tok_number) {
	    v_push(*object);
	    enumber_get(*object, &r);
	}
	else if (op_token == tok_eof || (token != tok_ne && token != tok_eq))
	    macro_cond_error();
	else {
	    r.t = t_int;
	    r.v.i = (eword_t)*object;
	}
	enumber_coerce(&l, &r);
	macro_push_check(l);
	macro_push_check(r);
	switch (token) {
	    case tok_ne:	enumber_ne(&l, &r);	break;
	    case tok_lt:	enumber_lt(&l, &r);	break;
	    case tok_le:	enumber_le(&l, &r);	break;
	    case tok_eq:	enumber_eq(&l, &r);	break;
	    case tok_ge:	enumber_ge(&l, &r);	break;
	    default:		enumber_gt(&l, &r);	break;
	}
	*object = enumber_create(&l);
	v_leave();
    } while (ekind_of(token = macro_lookahead()) == tok_logcmp);

    return (tok_number);
}

static etoken_t
macro_logop(eobject_t *object)
{
    evalue_t	l, r;
    etoken_t	token;
    etoken_t	op_token;

    if ((op_token = macro_logcmp(object)) == tok_eof)
	return (tok_eof);
    if (ekind_of(token = macro_lookahead()) != tok_logop)
	return (op_token);

    do {
	v_enter();

	v_check(4);
	macro_consume();
	v_push(*object);
	if (op_token == tok_number)
	    enumber_get(*object, &l);
	else {
	    l.t = t_int;
	    l.v.i = (eword_t)*object;
	}
	if ((op_token = macro_logcmp(object)) == tok_number) {
	    v_push(*object);
	    enumber_get(*object, &r);
	}
	else if (op_token == tok_eof)
	    macro_cond_error();
	else {
	    r.t = t_int;
	    l.v.i = (eword_t)*object;
	}
	enumber_coerce(&l, &r);
	macro_push_check(l);
	macro_push_check(r);
	switch (token) {
	    case tok_andand:	enumber_andand(&l, &r);	break;
	    default:		enumber_oror(&l, &r);	break;
	}
	*object = enumber_create(&l);
	v_leave();
    } while (ekind_of(token = macro_lookahead()) == tok_logop);

    return (tok_number);
}

static void
macro_defined(eobject_t object)
{
    eobject_t	 base;
    eobject_t	 cons;
    esymbol_t	*name;
    eint32_t	 paren;

    paren = 0;
    for (cons = object; cons; cons = ecdr(cons)) {
	if (ecar(cons) == defined) {
	    base = cons;
	    for (cons = ecdr(cons); cons; cons = ecdr(cons)) {
		name = ecar(cons);
		if (esymbol_p(name)) {
		    if (name->a_token && eget_fixnum(name->value) == tok_list)
			++paren;
		    else
			break;
		}
		else
		    macro_cond_error();
	    }
	    if (cons == null)
		macro_cond_error();
	    /* this operation has no side effects, so,
	     * if parenthesis are unbalanced, it will fail elsewhere */
	    if (eget_hash(ht_defines, name))
		erplaca(base, efixnum(1));
	    else
		erplaca(base, efixnum(0));
	    while (paren) {
		if ((cons = ecdr(cons)) == null)
		    macro_cond_error();
		name = ecar(cons);
		if (esymbol_p(name) && eget_fixnum(name->value) == tok_elist)
		    --paren;
		else
		    macro_cond_error();
	    }
	    /* (... defined #\( sym #\) ...) => (... <result> ...) */
	    erplacd(base, ecdr(cons));
	}
    }
}

static void
macro_cond_error(void)
{
    input->line = macro_cond_line;
    eread_error(null, "macro conditional syntax error");
}

/* short-circuit evaluation of && and || is not done, because the
 * expressions dont have side effects, and would need to read the
 * objects anyway, to parse the tokens to check for proper syntax
 */
static ebool_t
macro_cond(void)
{
    eobject_t	 cons;
    eint32_t	 line;
    esymbol_t	*name;
    eobject_t	 object;
    v_enter();

#if DEBUG
    /* this function is not recursive */
    if (object_list)
	eread_error(null, "internal error (recursive macro_cond())");
#endif

    v_check(1);
    macro_conditional = true;

    cons = null;
    line = macro_cond_line;
    macro_cond_line = input->line;

    /* read full #if or #elif expression */
    object = null;
    for (name = macro_object(true);
	 name != object_eof;
	 name = macro_object(true)) {
	if (object == null) {
	    object = cons = econs_nil(name);
	    v_push(object);
	}
	else {
	    erplacd(cons, econs_nil(name));
	    cons = ecdr(cons);
	}
    }

    if (object == null)
	/* empty expression */
	macro_cond_error();

    /* expand `defined' before macro expansion */
    macro_defined(object);

    /* evaluate macros in #if or #elif expression */
    object_list = object;
    object_limit = object_eof;
    object = null;
    for (name = read_object(); name != object_eof; name = read_object()) {
	if (object == null) {
	    object = cons = econs_nil(name);
	    v_top() = object;
	}
	else {
	    erplacd(cons, econs_nil(name));
	    cons = ecdr(cons);
	}
    }

    /* expand possible `defined' usage left after macro expansion */
    macro_defined(object);

    object_list = object;
    macro_lah_value = null;
    macro_lah_token = tok_eof;
    macro_logop(&object);
    if (object_list || macro_lah_token != tok_eof)
	macro_cond_error();

    object_limit = null;
    macro_cond_line = line;
    macro_conditional = false;
    v_leave();

    return (!efalse_p(object));
}

static emacro_t *
macro_define(esymbol_t *name)
{
    eobject_t	 cons;
    eentry_t	*entry;
    emacro_t	*macro;
    eint32_t	 count;
    eint32_t	 state;

    v_check(1);
    enew(&macro, macro);
    v_push(macro);
    macro->name = name;

    /* macro function definition cannot have spaces between name and parenthesis */
    if ((state = egetc(input)) == '(') {
#define wait_sep	(1 << 0)
#define wait_sym	(1 << 1)
#define wait_end	(1 << 2)
	count = 0;
	state = wait_sym|wait_end;
	enew_hash((eobject_t *)&macro->hash, H_pointer, 5);
	for (name = macro_object(true);; name = macro_object(true)) {
	    if (!esymbol_p(name))			goto macro_fail;
	    if (name->a_token) {
		switch (eget_fixnum(name->value)) {
		    case tok_elist:
			if (!(state & wait_end))	goto macro_fail;
			goto macro_define;
		    case tok_comma:
			if (!(state & wait_sep))	goto macro_fail;
			state = wait_sym;
			break;
		    case tok_ellipsis:
			if (macro->vararg ||
			    !(state & wait_sym))	goto macro_fail;
			macro->vararg = true;
			state = wait_end;
			break;
		    default:				goto macro_fail;
		}
	    }
	    else {
		if (!(state & wait_sym))		goto macro_fail;
		if (eget_hash(macro->hash, name))
		    eread_error(null, "macro argument '%p' redefined",
				name->name);
		enew(&entry, entry);
		entry->name = name;
		entry->value = efixnum(count);
		eput_hash(macro->hash, entry);
		++count;
		state = wait_sep|wait_end;
	    }
	}
#undef wait_end
#undef wait_sym
#undef wait_sep
    }
    else
	eungetc(input, state);

macro_define:
    cons = null;
    while ((name = macro_object(true)) != object_eof) {
	if (macro->value == null)
	    macro->value = cons = econs_nil(name);
	else {
	    erplacd(cons, econs_nil(name));
	    cons = ecdr(cons);
	}
    }
    v_dec();

    return (macro);
macro_fail:
    eread_error(null, "macro argument syntax error");
}

static eobject_t
macro_string(eobject_t object)
{
    eformat_t	 format;
    eobject_t	 concat;
    estream_t	*stream;
    evector_t	*vector;

    memset(&format, 0, sizeof(eformat_t));
    format.read = 1;
    format.prec = 6;
    format.radix = 10;
    vector = tmain->vec;
    vector->offset = vector->length = 0;
    stream = (estream_t *)vector;
    concat = object;
    while (concat) {
	if (econs_p(concat)) {
	    if (concat != object)
		eputc(stream, ' ');
	    object = ecar(concat);
	    concat = ecdr(concat);
	}
	else
	    concat = null;
	switch (etype(object) & ~t_const) {
	    case t_fixnum:
		eprint_int(stream, &format, eget_fixnum(object));
		break;
	    case t_int:
		eprint_int(stream, &format, *(eint_t *)object);
		break;
	    case t_float:
		eprint_flt(stream, &format, *(efloat_t *)object);
		break;
	    case t_mpz:
		eprint_mpz(stream, &format, *(empz_t *)object);
		break;
	    case t_mpq:
		eprint_mpq(stream, &format, *(empq_t *)object);
		break;
	    case t_mpr:
		eprint_mpr(stream, &format, *(empr_t *)object);
		break;
	    case t_symbol:
		format.read = 0;
		eprint_str(stream, &format, ((esymbol_t *)object)->name);
		format.read = 1;
		break;
	    case t_string:
		eprint_str(stream, &format, object);
		break;
	    default:
#if DEBUG
		eread_error(null, "unexpected object in # expansion");
#else
		break;
#endif
	}
    }

    return (eget_string(vector->v.obj, vector->length));
}

static eobject_t
macro_function(emacro_t *macro, eobject_t *alist,
	       eobject_t *elist, eobject_t vlist)
{
    eobject_t	 cons;
    esymbol_t	*name;
    eobject_t	 prev;
    esymbol_t	*check;
    eentry_t	*entry;
    eobject_t	 value;
    eobject_t	 concat;
    eobject_t	 object;
    ebool_t	 cons_p;
    eint32_t	 offset;
    v_enter();

    object = cons = prev = null;
    for (value = macro->value; value; prev = value, value = ecdr(value)) {
	name = ecar(value);
	if (esymbol_p(name)) {
	    if (name->a_token) {
		switch (eget_fixnum(name->value)) {
		    case tok_stringify:
			if ((value = ecdr(value)) == null) {
			    eread_warn(null, "# not followed by macro parameter");
			    goto done;
			}
			name = ecar(value);
			if (!esymbol_p(name) || name->a_token ||
			    (entry = eget_hash(macro->hash, name)) == null)
			    eread_warn(null, "# not followed by macro parameter");
			else {
			    name = alist[eget_fixnum(entry->value)];
			    if (name == null)
				continue;
			    name = macro_string(name);
			}
			break;
		    case tok_VA_ARGS:
			/* dont insert __VA_ARGS__ token in expansion */
			if (!macro->vararg) {
			    eread_warn(null, "__VA_ARGS__ on non vararg macro");
			    continue;
			}
			if ((name = vlist) == null)
			    continue;
			break;
		    case tok_comma:
			/* check for , ## <arg> */
			if (ecdr(value) == null)
			    goto macro_concat;
			check = ecadr(value);
			if (!esymbol_p(check) || !check->a_token ||
			    check->value != efixnum(tok_concat))
			    goto macro_concat;

			cons_p = true;
			goto comma;

			/* comma won't form a valid token with another token */
		    case tok_concat:
			cons_p = false;
			if (prev == value || (concat = ecdr(value)) == null)
			    break;
			check = ecar(prev);
			if (!esymbol_p(check) || !check->a_token ||
			    check->value != efixnum(tok_comma))
			    break;
			check = ecar(concat);
			goto concat;

		    comma:
			concat = ecdr(value);
			if (ecdr(concat) == null)
			    goto macro_concat;

			check = ecadr(concat);
		    concat:
			if (!esymbol_p(check))
			    goto macro_concat;
			if (check->a_token &&
			    check->value == efixnum(tok_VA_ARGS)) {
			    if (!macro->vararg)
				eread_warn(null, "__VA_ARGS__ on non vararg macro");
			    if (cons_p && vlist == null) {
				/* dont insert ',' in expansion */
				value = ecdr(concat);
				continue;
			    }
			    /* don't generate a warning later, due to
			     * trying to concatentate ',' and varargs */
			    else if (!cons_p)
				continue;
			}
			else if ((entry = eget_hash(macro->hash, check))) {
			    if (cons_p &&
				alist[eget_fixnum(entry->value)] == null) {
				/* dont insert ',' in expansion */
				value = ecdr(concat);
				continue;
			    }
			    else if (!cons_p)
				continue;
			}
			break;
		    default:
			break;
		}
	    }
	    else if ((entry = eget_hash(macro->hash, name))) {
		offset = eget_fixnum(entry->value);
		/* don't add null inplace of empty argument */
		if ((name = elist[offset]) == null)
		    continue;
		/* if previous token was '##', add non evaluated argument */
		if (prev) {
		    check = ecar(prev);
		    if (esymbol_p(check) && check->a_token &&
			check->value == efixnum(tok_concat))
			name = alist[offset];
		}
		/* if next token is '##', add non evaluated argument */
		else if (ecdr(value)) {
		    check = ecadr(value);
		    if (esymbol_p(check) && check->a_token &&
			check->value == efixnum(tok_concat))
			name = alist[offset];
		}
	    }
	}

    macro_concat:
	cons_p = econs_p(name);
	if (object == null) {
	    object = cons = econs_nil(cons_p ? ecar(name) : name);
	    v_push(object);
	}
	else {
	    erplacd(cons, econs_nil(cons_p ? ecar(name) : name));
	    cons = ecdr(cons);
	}
	if (cons_p) {
	    for (name = ecdr(name); name; name = ecdr(name)) {
		erplacd(cons, econs_nil(ecar(name)));
		cons = ecdr(cons);
	    }
	}
    }

done:
    v_leave();

    return (ecopy_tree(object));
}

/* fills elist with expansion of alist, to "properly" implement ## and # */
static void
macro_evaluate(eint32_t count, eentry_t *entry,
	       eobject_t *alist, eobject_t *elist)
{
    eobject_t	cons;
    eobject_t	tail;
    eobject_t	limit;
    eobject_t	value;
    eint32_t	offset;
    eobject_t	object;
    eobject_t	expand;
    ebool_t	conditional;

    /* save state */
    limit = object_limit;
    value = entry->value;
    conditional = macro_conditional;

    /* dont replace empty value macros with '0' if
     * expanding function macros in #if or #elif expression */
    macro_conditional = false;

    for (offset = 0; offset < count; offset++) {
	/* if nothing to evaluate */
	if (alist[offset] == null)
	    continue;
	/* insert argument list to expand in global object_list used by
	 * read_object(), that happens to fully expand macros */
	for (tail = alist[offset]; ecdr(tail); tail = ecdr(tail))
	    ;
	/* insert object_list at the end of alist[offset] */
	erplacd(tail, object_list);
	expand = object_list;
	object_list = alist[offset];
	object_limit = expand ? expand : object_eof;
	/* evaluate arguments */
	cons = null;
	for (object = read_object(); ; object = read_object()) {
	    object = ecopy_tree(object);
	    if (elist[offset] == null)
		elist[offset] = cons = econs_nil(object);
	    else {
		erplacd(cons, econs_nil(object));
		cons = ecdr(cons);
	    }
	    if (object_list == expand)
		break;
	}
	/* restore alist[offset] */
	erplacd(tail, null);
	object_list = expand;

	/* update entry, in case of macro argument being a call to itself */
	entry->value = value;
    }

    /* restore state */
    object_limit = limit;
    macro_conditional = conditional;
}

static eobject_t
macro_expand(emacro_t *macro)
{
    eobject_t	 cons;
    esymbol_t	*name;
    eentry_t	*entry;
    eint32_t	 level;
    eobject_t	*alist;		/* argument list */
    eobject_t	*elist;		/* expanded list */
    eobject_t	 value;
    eobject_t	 vlist;		/* varargs list */
    eformat_t	 format;
    eobject_t	 object;
    eint32_t	 offset;
    ebool_t	 cons_p;
    eentry_t	*expand;
    esymbol_t	*concat;
    evector_t	*vector;
    v_enter();

    if ((expand = eget_hash(expand_hash, macro->name))) {
	for (value = expand->value, cons = object_list; cons; cons = ecdr(cons))
	    if (cons == value)
		return (macro->name);
    }
    else {
	enew(&expand, entry);
	expand->name = macro->name;
	eput_hash(expand_hash, expand);
    }
    expand->value = object_list;

    v_check(6);
    v_push(expand);
    vlist = null;

    /* if a function macro */
    if (macro->hash) {
	name = read_object();
	if (esymbol_p(name) && name->a_token &&
	    name->value == efixnum(tok_list)) {
	    if (macro->hash->count) {
		/* create a gc protected a vector */
		evector((evector_t **)&alist, t_void, macro->hash->count, 1);
		v_push(alist);
		evector((evector_t **)&elist, t_void, macro->hash->count, 1);
		v_push(elist);
		/* simpler dereference */
		elist = ((evector_t *)elist)->v.ptr;
		alist = ((evector_t *)alist)->v.ptr;
	    }
	    else
		alist = elist = null;
	    level = 1;
	    offset = 0;
	    for (name = macro_object(false); ; name = macro_object(false)) {
		if (name == object_eof)
		    eread_error(null, "unexpected end of file");
		if (esymbol_p(name) && name->a_token) {
		    switch (eget_fixnum(name->value)) {
			case tok_list:
			    ++level;
			    break;
			case tok_elist:
			    if (--level == 0) {
				if (offset + 1 < macro->hash->count)
				    eread_error(null,
						"too few arguments to '%p'",
						macro->name->name);
				goto macro_expand;
			    }
			    break;
			case tok_comma:
			    if (level == 1) {
				if (++offset >= macro->hash->count) {
				    if (macro->vararg)
					goto macro_vararg;
				    eread_error(null,
						"too many arguments to '%p'",
						macro->name->name);
				}
				continue;
			    }
			default:
			    break;
		    }
		}
		else if (offset >= macro->hash->count) {
		    if (macro->vararg) {
			/* unread object; this happens in macros in the
			 * format: #define macro(...) due to the logic
			 * used to read objects, but no big deal in
			 * allocating an extra temporary cons cell */
			object_list = econs(name, object_list);
			goto macro_vararg;
		    }
		    eread_error(null, "too many arguments to '%p'",
				macro->name->name);
		}

		if (alist[offset] == null)
		    alist[offset] = cons = econs_nil(name);
		else {
		    erplacd(cons, econs_nil(name));
		    cons = ecdr(cons);
		}
	    }

	macro_vararg:
	    for (name = read_object(); ; name = read_object()) {
		if (name == object_eof)
		    eread_error(null, "unexpected end of file");
		if (esymbol_p(name) && name->a_token) {
		    switch (eget_fixnum(name->value)) {
			case tok_list:
			    ++level;
			    break;
			case tok_elist:
			    if (--level == 0)
				goto macro_expand;
			default:
			    break;
		    }
		}
		if (vlist == null) {
		    vlist = cons = econs_nil(name);
		    v_push(vlist);
		}
		else {
		    erplacd(cons, econs_nil(name));
		    cons = ecdr(cons);
		}
	    }

	macro_expand:
	    macro_evaluate(macro->hash->count, expand, alist, elist);

	    if ((object = macro_function(macro, alist, elist, vlist)))
		v_push(object);

	    /* flag that object doesn't need to be duplicated */
	    cons_p = true;
	    goto macro_update;
	}
	else {
	    /* not called as a function */
	    cons_p = false;
	    object = macro->name;
	    if (name != object_eof)
		object_list = econs(name, object_list);
	    goto macro_update;
	}
    }
    else {
	/* flag that object needs to be duplicated */
	cons_p = false;
	name = macro->value;
	if (econs_p(name) && ecdr(name) == null)
	    name = ecar(name);
    }

    if (esymbol_p(name) && !name->a_token) {
	do {
	    if ((entry = eget_hash(ht_defines, name))) {
		name = entry->value;
		if (econs_p(name) && ecdr(name) == null)
		    name = ecar(name);
	    }
	}
	while (entry && esymbol_p(name) && !name->a_token &&
	       name != macro->name);
    }
    object = name;

macro_update:
    if (econs_p(object)) {
	vector = tmain->vec;

	if (object_list) {
	    /* if already duplicated */
	    if (!cons_p)
		object = ecopy_tree(object);
	    erplacd(elast(object), object_list);
	}

	object_list = object;

	/* traverse list checking for concatenations in macro expansion */
	for (cons = concat = object; cons; concat = cons, cons = ecdr(cons)) {
	    name = ecar(cons);
	    /* only concatenate symbols */
	    if (!esymbol_p(name))
		continue;
	    /* token symbols can only be merged with other token symbols */
	    if (name->a_token) {
		switch (eget_fixnum(name->value)) {
		    case tok_VA_ARGS:
			if (!macro->vararg)
			    eread_warn(null, "__VA_ARGS__ on non vararg macro");
			name = ecdr(cons);
			/* remove empty __VA_ARGS__ from expansion */
			if (concat == object_list)
			    object_list = ecdr(object_list);
			else
			    erplacd(concat, name);
			continue;
			/* stringify on non macro argument */
		    case tok_stringify:
			erplacd(concat, ecdr(cons));
			if (ecdr(cons))
			    erplaca(ecdr(cons), macro_string(ecadr(cons)));
			/* not silently, remove '#' from expansion */
			eread_warn(null, "# not followed by macro parameter");
			if (concat == object_list)
			    object_list = cons = ecdr(object_list);
			else
			    cons = concat;
			continue;
		    case tok_concat:
			/* remove concat object */
			if (ecdr(cons))
			    erplacd(cons, ecddr(cons));
			else
			    erplacd(cons, null);
			/* ## without a symbol before it and
			 * possibly without a symbol after it */
			concat_warning:
			eread_warn(null, "## doesn't form a valid token");
			continue;
		    default:
			break;
		}
	    }
	    /* if nothing follows symbol */
	    if (ecdr(cons) == null)
		continue;
	    /* remember previous symbol */
	    concat = name;
	    /* check if next object is concat object */
	    name = ecadr(cons);
	    if (!esymbol_p(name) || !name->a_token ||
		name->value != efixnum(tok_concat))
		continue;
	    /* remove concat object */
	    erplacd(cons, ecddr(cons));
	    /* if ## without an object after it */
	    if (ecdr(cons) == null)
		goto concat_warning;
	    name = ecadr(cons);
	    /* check for a compatible object after ## */
	    switch (etype(name)) {
		case t_fixnum:
		case t_int:
		    if (eget_integer(name) < 0)
			goto concat_warning;
		    break;
		case t_symbol:
		    break;
		default:
		    goto concat_warning;
	    }
	    /* check if need to resize vector pointer */
	    offset = concat->name->length +
		(esymbol_p(name) ? name->name->length : 0);
	    if (offset > eobject_length(vector->v.obj))
		eresize_object(&vector->v.obj, offset);
	    /* build concatenated symbol string */
	    offset = concat->name->length;
	    memcpy(vector->v.obj, concat->name->v.obj, offset);
	    if (esymbol_p(name)) {
		memcpy(vector->v.u8 + offset,
		       name->name->v.u8, name->name->length);
		offset += name->name->length;
	    }
	    else {
		memset(&format, 0, sizeof(eformat_t));
		format.radix = 10;
		vector->offset = vector->length = offset;
		offset += eprint_int((estream_t *)vector, &format,
				     eget_integer(name));
	    }
	    vector = eget_string(vector->v.obj, offset);
	    /* check if symbol already exists */
	    if ((value = eget_symbol(ht_language, vector)) == null) {
		/* punctuation concatenating must generate a valid token
		 * note also that keywords are also treated as tokens and
		 * not as "normal" symbols */
		for (--offset; offset >= 0; --offset) {
		    if (!symbol_char_p(vector->v.u8[offset]))
			goto concat_warning;
		}
		value = enew_symbol(ht_language, vector);
	    }
	    /* update object list */
	    erplaca(cons, value);
	    if (ecdr(cons))
		erplacd(cons, ecddr(cons));
	}

	object = ecar(object_list);
	object_list = ecdr(object_list);
    }

    /* update expand level value, in case of recursion */
    if (object_list && expand->value == null) {
	for (cons = object_list; ecdr(cons); cons = ecdr(cons))
	    ;
	expand->value = cons;
    }

    v_leave();

    /* if macro definition is empty */
    if (object == null) {
	if (!macro_conditional)
	    object = read_object();
    }
    else if (object != macro->name &&
	     esymbol_p(object) && !((esymbol_t *)object)->a_token &&
	     (macro = (emacro_t *)eget_hash(ht_defines, object)))
	object = macro_expand(macro);

    return (object);
}

static eobject_t
macro_read(void)
{
    eint32_t	 ch;
    eobject_t	 p, q;
    eint32_t	 line;
    evector_t	*name;
    ebool_t	 same;
    emacro_t	*prev;
    emacro_t	*macro;
    eentry_t	*entry;
    estream_t	*stream;
    esymbol_t	*symbol;

    /* save value now, as macro_ident() may read a newline */
    line = input->line;
    name = input->name;
    symbol = macro_ident();
    if ((entry = eget_hash(ht_preprocessor, symbol)) == null)
	eread_error(null, "bad preprocessor '%p'", symbol->name);

    switch (eget_fixnum(entry->value)) {
	case mac_define:
	    symbol = macro_ident();
	    if (symbol->a_token || symbol == defined)
		eread_error(null, "'%p' cannot name a macro", symbol->name);
	    prev = (emacro_t *)eget_hash(ht_defines, symbol);
	    macro = macro_define(symbol);
	    if (prev) {
		same = true;
		p = prev->value, q = macro->value;
		for (; p && q; p = ecdr(p), q = ecdr(q)) {
		    if (ecar(p) != ecar(q)) {
			same = false;
			break;
		    }
		}
		if (same)	same = !(p || q);
		if (same)	same = (!!prev->hash ^ !!macro->hash) == 0;
		if (same)	same = prev->vararg == macro->vararg;
		if (same &&
		    prev->hash)	same = prev->hash->count == macro->hash->count;
		if (!same)
		    eread_warn(null, "macro '%p' redefined", symbol->name);
	    }
	    eput_hash(ht_defines, (eentry_t *)macro);
	    break;
	case mac_undef:
	    if ((entry = eget_hash(ht_defines, macro_ident())))
		erem_hash(ht_defines, entry);
	    macro_check();
	    break;
	case mac_include:
	    break;
	case mac_ifdef:
	    symbol = macro_ident();
	    macro_check();
	    macro_state_inc();
	    if (macro_state->offset == 1) {
		macro_name = name;
		macro_line = line;
	    }
	    if (eget_hash(ht_defines, symbol) == null)
		macro_ignore();
	    else
		macro_set_true();
	    break;
	case mac_ifndef:
	    symbol = macro_ident();
	    macro_check();
	    macro_state_inc();
	    if (macro_state->offset == 1) {
		macro_name = name;
		macro_line = line;
	    }
	    if (eget_hash(ht_defines, symbol) != null)
		macro_ignore();
	    else
		macro_set_true();
	    break;
	case mac_if:
	    macro_state_inc();
	    macro_name = name;
	    macro_line = line;
	    if (macro_cond() == false)
		macro_ignore();
	    else
		macro_set_true();
	    break;
	case mac_elif:
	    if (!macro_state->offset || macro_get_else())
		eread_error(null, "unexpected #elif");
	    else if (macro_state->offset == 1) {
		macro_name = name;
		macro_line = line;
	    }
	    macro_skip_line();
	    macro_ignore();
	    break;
	case mac_else:
	    if (!macro_state->offset || macro_get_else())
		eread_error(null, "unexpected #else");
	    else if (macro_state->offset == 1) {
		macro_name = name;
		macro_line = line;
	    }
	    macro_set_else();
	    macro_check();
	    macro_ignore();
	    break;
	case mac_endif:
	    if (!macro_state->offset)
		eread_error(null, "unexpected #endif");
	    macro_check();
	    macro_clr_bits();
	    if (--macro_state->offset > 0 && !macro_get_true())
		macro_ignore();
	    break;
	case mac_error:
	case mac_warning:
	    stream = (estream_t *)tmain->vec;
	    stream->offset = stream->length = 0;
	    eungetc(input, macro_skip());
	    for (ch = egetc(input); ch != eof && ch != '\n'; ch = egetc(input))
		eputc(stream, ch);
	    /* backup line number */
	    eungetc(input, ch);
	    if (entry->value == efixnum(mac_error))
		eread_error(null, "%p", stream);
	    else
		eread_warn(null, "%p", stream);
    }

    return (read_object());
}

static eobject_t
read_character(void)
{
    eint32_t	bytes;
    eobject_t	object;

    bytes = scan_chr(input);
    if (bytes == 0)
	eread_error(null, "character constant too short");
    else if (bytes == eof)
	eread_error(null, "expecting '\''");

    if (tmain->ret.t == t_int)
	einteger(&object, tmain->ret.v.i);
    else
	enew_mpz(&object, thr_zr);

    return (object);
}

static evector_t *
read_string(void)
{
    eint32_t	length;

    if ((length = scan_str(input)) < 0)
	eread_error(null, "expecting '\"'");

    return (eget_string(tmain->vec->v.obj, length));
}

static eobject_t
read_number(eint32_t ch)
{
    eobject_t	object;

    eread_lock(input);
    scan_num(input, 0, ch, false);
    eread_unlock(input);

    ch = egetc(input);
    /* check delimiter */
    if (symbol_char_p(ch))
	eread_error(null, "'%c' follows number", ch);
    eungetc(input, ch);

    switch (tmain->ret.t) {
	case t_mpr:
	    enew_mpr(&object, thr_rr);
	    break;
	case t_float:
	    enew_float(&object, tmain->ret.v.d);
	    break;
	case t_mpz:
	    enew_mpz(&object, thr_zr);
	    break;
	case t_mpq:
	    enew_mpq(&object, thr_qr);
	    break;
	case t_int:
	    einteger(&object, tmain->ret.v.i);
	    break;
	case t_cdd:
	    ecdd(&object, tmain->ret.v.cdd);
	    break;
	case t_cqq:
	    ecqq(&object, &tmain->qq);
	    break;
	case t_mpc:
	    enew_mpc(&object, &tmain->c);
	    break;
	default:
	    eread_error(null, "syntax error");
    }

    return (object);
}

static eobject_t
read_symbol(eint32_t ch)
{
    esymbol_t	*symbol;

    symbol = enew_symbol(ht_language, read_ident(ch));
    if (symbol->a_token) {
	switch (eget_fixnum(symbol->value)) {
	    case tok_FILE:
		symbol = (esymbol_t *)input->name;
		break;
	    case tok_LINE:
		einteger((eobject_t *)&symbol, input->line);
		break;
	    case tok_DATE:
		symbol = macro_date();
		break;
	    case tok_TIME:
		symbol = macro_time();
		break;
	    case tok_COUNTER:
		einteger((eobject_t *)&symbol, macro_counter);
		++macro_counter;
	    default:
		break;
	}
    }

    return (symbol);
}

static eobject_t
read_keyword(eint32_t ch)
{
    esymbol_t	*symbol;
    eobject_t	 object;
    evector_t	*vector;
    eint32_t	 length;
    euint8_t	 buffer[5];

    /* longest operators are <<<= and >>>= */
    length = 1;
    symbol = null;
    buffer[0] = ch;
    for (vector = eget_string(buffer, length),
	 object = eget_symbol(ht_language, vector);
	 object && length <= 4;
	 vector = eget_string(buffer, length),
	 object = eget_symbol(ht_language, vector)) {
	symbol = object;
	ch = egetc(input);
	buffer[length++] = ch;
    }

    /* if it wasn't a 3 or 4 characters operator, push back last read char */
    if (object == null) {
	/* '.' and '...' are "keywords", but not '..' */
	if (buffer[0] == '.' && length == 2 && buffer[1] == '.') {
	    if ((ch = egetc(input)) == '.') {
		buffer[2] = '.';
		length = 3;
	    }
	    else {
		eungetc(input, ch);
		eungetc(input, buffer[1]);
		length = 1;
	    }
	    symbol = eget_symbol(ht_language, eget_string(buffer, length));
	}
	else
	    eungetc(input, ch);
    }

    if (symbol == null) {
	buffer[length] = '\0';
	eread_error(null, "syntax error near '%s'", buffer);
    }

    return (symbol);
}

static eint32_t
char_value(eint32_t ch, int base)
{
    eint32_t	value;

    if (ch >= '0' && ch <= '9')
	value = ch - '0';
    else if (ch >= 'a' && ch <= 'f')
	value = ch - 'a' + 10;
    else if (ch >= 'A' && ch <= 'F')
	value = ch - 'A' + 10;
    else
	value = eof;

    return (value >= 0 && value < base ? value : eof);
}
